home *** CD-ROM | disk | FTP | other *** search
/ Collection of Tools & Utilities / Collection of Tools and Utilities.iso / batchut / rap101.zip / COMMON.SRC < prev    next >
Text File  |  1989-05-10  |  38KB  |  1,494 lines
  1. ; COMMON.RAP -- standard interaction routines for RAP
  2. ;               copyright 1988 SIL
  3. ;
  4. ;       Gary F. Simons, SIL / Kirk Parker, SIL
  5. ;
  6. ;        Version 1.01 - 10 May 1989
  7. ;                     a. #filesize now reports in Kbytes
  8. ;                     b. *get_input_file now detects non-existent files
  9. ;       Version 1.0  - Released 10 Oct 1988
  10. ;       previously major version:  23 September 1988  khp    for RAP 0.88
  11. ;
  12. ;----------------------------------------------------------
  13. ;
  14. ; This file contains loose code, which enables it to declare some
  15. ; "truly" global variables and to execute some start-up code.
  16. ; As a result, this file is sensitive to the order in which it is loaded:
  17. ;
  18. ;   1. COMMON.RAP must be .included before all other program files that
  19. ;      contain subroutines.  It is still possible to include other files
  20. ;      ahead of COMMON.RAP as long as those files contain only loose code
  21. ;      and/or .define statements.
  22. ;
  23. ;   2. No file loaded after COMMON.RAP may contain loose code.
  24. ;
  25. ; While this will restrict the use of loose code by user programs, the
  26. ; benefits of using the subroutine library far outweigh this minor drawback.
  27. ; Note that using a main subroutine results in a better-documented program
  28. ; anyway!
  29.  
  30. .define .LOCALMATCH declare $left,$match,$right
  31. .define .BELL t:*chr(7)\
  32. .define .YES 1
  33. .define .NO 0
  34.  
  35. ; return values from *existf:
  36.  
  37. .define .NOTFOUND 0
  38. .define .READWRITE 2
  39. .define .READONLY 4
  40.  
  41. .define .MININT (-2147483639)
  42. .define .MAXINT   2147483639
  43.  
  44. ; longest allowed slashcode:
  45.  
  46. .define .MAXCODE 78
  47.  
  48. ; valid filename chars:
  49.  
  50. .define .FILECHARS a-z0-9_A-Z!@#$%^&()'`{}~\-
  51.  
  52. ; 0 - (amount of extra space desired) for ensure_space
  53.  
  54. .define .HEADROOM -10240
  55.  
  56. ;----------------------------------------------------------
  57. ; the following variables must be declared at the global level
  58. ; this group is documented as accessible to the user:
  59.  
  60. #verbose=1                            ; are explanations enabled? default = yes
  61.  
  62. if ($screentype == "Sharp LCD")        ; inter-line spacing for query routines
  63.     $skip=$null
  64. else
  65.     $skip=$newline*chr(13)
  66. endif
  67.  
  68. $valdr=*getdr__()                    ; list of valid disk drives
  69.  
  70. ; this group is non-documented and for internal use only
  71.  
  72. #help__= -1           ; help-file descriptor.  default = help file not opened
  73.                     ; help file name for closing/reopening (default = none)
  74. $helpfile__=
  75. $dospath__=$path    ; save original PATH so we can access it from library
  76.                     ; routines even if caller changes $path
  77.  
  78. ;------------------------------------------------------------
  79. ; error
  80. ;
  81. ;  effect: Sound the alarm and display an error message.  If help
  82. ;          is available, tell the user about it.
  83. ;
  84. ;  inputs: $message  the message to display
  85. ;          $topic    the help topic pertinent to the question that
  86. ;                    was answered incorrectly
  87. ;
  88.  
  89. proc error($message,$topic)
  90.  
  91. declare $tag,$indent
  92. .LOCALMATCH
  93.  
  94. ; add a period to message if needed
  95. if (not ($message contains "[.!?]$"))
  96.     $message=$message.
  97. endif
  98.  
  99. if ($message contains "^[ \\t][ \\t]*")    ; we want the side effect only
  100.     $indent=$match
  101. endif
  102.  
  103. t:$skip*chr(7)$message\
  104.  
  105. if ($topic == "")
  106.     $tag=Try again.
  107. else
  108.     $tag=Try again.  (Type ? for help.)
  109. endif
  110.  
  111. ; terminate line if tag won't fit, indent next line same as message
  112.  
  113. if ((*strlen($message) + *strlen($tag)) > 72)
  114.     t:
  115.     t:$indent\
  116. else
  117.     t:  \
  118. endif
  119.  
  120. t:$tag
  121.  
  122. endproc
  123.  
  124. ; ----------------------------------------------------------
  125. ; warning
  126. ;
  127. ;   effect: Ring alarm and display message.  wait until user enters RETURN
  128. ;
  129.  
  130. proc warning($message)
  131.  
  132. if (not $message has "\\.?!$")
  133.     $message=$message.
  134. endif
  135.  
  136. t:$skip*chr(7)$message.
  137.  
  138. kbflush()
  139. foot
  140.  
  141. endproc
  142.  
  143. ;------------------------------------------------------------
  144. ; mount
  145. ;
  146. ; effect:  Ensure that the needed disk volume is mounted by waiting
  147. ;          for it to be mounted if it is not mounted already.
  148. ;
  149. ; inputs:  $drive  The one-letter designator of the drive
  150. ;          $id     The volume id of the disk that needs to be mounted
  151. ;          $name   The diskette name to be used in a prompt if the
  152. ;                     volume is not already mounted
  153. ;
  154.  
  155. proc mount_volume($drive,$id,$name,$topic)
  156.  
  157. declare $volname,#fd,#case,#opentest,#reopen_help
  158.  
  159. loop
  160.  
  161.     $volname=*volume($drive)
  162.     exit if ($volname == $id)
  163.  
  164.     ; ensure that there are no open files.  It's not safe to change the disk
  165.     ; if there's any chance of an open output file.
  166.  
  167.     if (not #opentest)      ; if we haven't already tested for open files
  168.         #opentest = 1
  169.         #fd = *open("nul")
  170.         close #fd
  171.  
  172.         if (#fd > 1 or (#fd > 0 and #help__ == -1))
  173.             t:*chr(7)
  174.             t:The program needs to change disks so that the $name
  175.             t:disk is accessible, but it is not safe to do so because the program has
  176.             t:one or more files open.
  177.             t:
  178.     
  179.             if ($topic <> "")
  180.                 explain($topic)
  181.             else
  182.                 t:   The program must terminate immediately.  Please report this
  183.                 t:   message to the program's author.
  184.             endif
  185.             foot
  186.             bye
  187.         endif
  188.     endif
  189.     if (#help__ >= 0)
  190.         close #help__
  191.         #help__ = -1
  192.         #reopen_help = 1
  193.     endif
  194.  
  195.     t:$skip\Put the $name disk in drive $drive.
  196.     kbflush()
  197.     foot:Press RETURN after you have done this.
  198.  
  199. endloop
  200.  
  201. if (#reopen_help)
  202.     reopen_help__()
  203. endif
  204.  
  205. endproc
  206.  
  207.  
  208. ; ----------------------------------------------------------
  209. proc panic__($location,$msg)    ; for internal error messages only
  210.  
  211. declare #paged
  212.  
  213. t:*chr(7)$skip\Internal error in \*$location:
  214. t:
  215. t:    $msg
  216. t:
  217. t:The program will continue to run, but the results may not be valid.
  218. t:Copy this message exactly, so you can report it to the program's author,
  219. t:and exit as soon as possible.  You may exit immediately by typing
  220. t:Ctrl-C.
  221. kbflush()
  222. foot
  223. endproc
  224.  
  225. ; ----------------------------------------------------------
  226. proc kbflush()
  227.  
  228. declare $junk
  229.  
  230. loop while (*keypress())
  231.     as $junk
  232. endloop
  233.  
  234. endproc
  235.  
  236. ; ----------------------------------------------------------
  237. ; getdr
  238. ;
  239. ; effect: assemble list of valid drive designators and return as string
  240. ;
  241. ; globals used: $cmdline
  242.  
  243. strfunc getdr__()
  244.  
  245. declare $drvlist,$tmp,#case,#tmp
  246. .LOCALMATCH
  247.  
  248. ; look for /drive=LIST...  on command line
  249.  
  250. if ($cmdline contains "[-/]drive=[ \\t]*")
  251.     $drvlist=$right
  252.     if ($drvlist contains "[ \\t]")
  253.         $drvlist=$left
  254.     endif
  255.     return $drvlist
  256. endif
  257.  
  258. if ($screentype == "Sharp LCD")
  259.  
  260.     if (*freesp("P") == -1)
  261.         return "ABCDG"
  262.     else
  263.         return "ABCDGP"
  264.     endif
  265.  
  266. else        ; it's not a Sharp
  267.  
  268.     $drvlist=AB
  269.     $tmp=C
  270.  
  271.     loop while (*freesp($tmp) > 0)
  272.         $drvlist=$drvlist$tmp
  273.         #tmp = *ascii($tmp) + 1
  274.         $tmp=*chr(#tmp)
  275.     endloop
  276.  
  277.     return $drvlist
  278.  
  279. endif
  280.  
  281. endfunc
  282.  
  283. ;----------------------------------------------------------
  284. ; explain - display help-file information.  *Explain assumes the help-file is
  285. ;           already open with the file descriptor in the global variable
  286. ;           #help.  It also tests the global variable #verbose which is 1 to
  287. ;           enable explanations and 0 to disable.  Note that some routines
  288. ;           (e.g. *get_ans) declare a local copy of #verbose that is set to 1,
  289. ;           thus enabling explanation on a local basis.
  290. ;
  291. ; A help-file has the following format:
  292. ;     \id line
  293. ;     [size line - if this line contains an int, set #fscale to its value]
  294. ;     zero or more index lines in the format topic_name: offset (in bytes)
  295. ;     zero or more topic entries beginning with \text topic_name
  296. ;
  297. ; *explain recognizes the following standard format markers in the help-file:
  298. ;
  299. ;   \text  - beginning of a topic
  300. ;   \cls   - execute a ch: command
  301. ;   \foot  - execute a foot command
  302. ;
  303. ; It may also recognize the following marker(s) in the near future:
  304. ;
  305. ;   \more  - like foot, but allows the user to choose between reading more or
  306. ;            exiting explain (this is similar to the way HELP works in ED.)
  307. ; ----------------------------------------------------------
  308.  
  309. proc explain($topic)
  310.  
  311. declare #case,$line
  312. .LOCALMATCH
  313.  
  314. if (not #verbose)       ; explanations are turned off
  315.     return
  316. else if (#help__ < 0)
  317.     t:There is no help-file available to this program.
  318.     foot                ;